home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / os2 / adaptor.zip / ADAPT.ZIP / adaptor / examples / dalib / cshift / test1.f < prev    next >
Text File  |  1993-04-27  |  1KB  |  75 lines
  1.       program shift_test
  2.  
  3.       parameter (n=100)
  4.  
  5.       real a(n), b(n)
  6.  
  7.       call cmf_random (b)
  8.  
  9.       call test (a,b,n, 1)
  10.       call test (a,b,n, -1)
  11.       call test (a,b,n, 49)
  12.       call test (a,b,n, 51)
  13.       call test (a,b,n, -51)
  14.       call test (a,b,n, 13)
  15.  
  16.       call test1 (a,b,n, 1)
  17.       call test1 (a,b,n, -1)
  18.       call test1 (a,b,n, 49)
  19.       call test1 (a,b,n, 51)
  20.       call test1 (a,b,n, -51)
  21.       call test1 (a,b,n, 13)
  22.  
  23.       end
  24.  
  25.       subroutine test1 (a, b, n, pos)
  26.       integer n
  27.       real a(n), b(n)
  28.       logical equal (n)
  29.       integer pos
  30.       integer errors
  31.  
  32.       a = b
  33.       do i = 1, n
  34.          a = cshift (a, 1, pos)
  35.       end do
  36.  
  37.       equal = (b .eq. a)
  38.       errors = count (equal)
  39.       errors = n - errors
  40.  
  41.       print *, errors, ' Errors for shifting in dim 1 with pos = ', pos
  42.       end
  43.  
  44.  
  45.       subroutine test (a, b, n, pos)
  46.       integer n
  47.       real a(n), b(n)
  48.       logical equal (n)
  49.       integer pos
  50.       integer errors
  51.  
  52.       a = b
  53.  
  54.       b = cshift (b, 1, pos)
  55.  
  56.       if (pos .gt. 0) then
  57.          do i = 1, pos
  58.             a = cshift (a, 1, 1) 
  59.          end do
  60.       end if
  61.  
  62.       if (pos .lt. 0) then
  63.          do i = 1, -pos
  64.             a = cshift (a, 1, -1) 
  65.          end do
  66.       end if
  67.  
  68.       equal = (b .eq. a)
  69.       errors = count (equal)
  70.       errors = n - errors
  71.  
  72.       print *, errors, ' Errors for shifting in dim 1 with pos = ', pos
  73.       end
  74.  
  75.